VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Connector"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Implements IConnector

Private m_Index As Long
Private m_Parent1 As Object
Private m_Parent2 As Object
'Private m_Type As Long

Private WithEvents Shape As Line
Attribute Shape.VB_VarHelpID = -1

Public Property Get Parent1() As Object
    Set Parent1 = m_Parent1
End Property

Public Property Get Parent2() As Object
    Set Parent2 = m_Parent2
End Property

Public Function SetParent1(par As Object) As Boolean
    Dim typ As Long
    SetParent1 = False
    If Validate(Parent1, Parent2) Then
        m_Parent1.IPort_DetachConnector Me
        par.IPort_AttachConnector Me
        Set m_Parent1 = par
        SetParent1 = True
    End If
End Function

Public Function SetParent2(par As Object) As Boolean
    Dim typ As Long
    SetParent2 = False
    If Validate(Parent1, Parent2) Then
        m_Parent2.IPort_DetachConnector Me
        par.IPort_AttachConnector Me
        Set m_Parent2 = par
        SetParent2 = True
    End If
End Function

Public Property Get Index() As Long
    Index = m_Index
End Property

Public Property Let Index(ByVal ind As Long)
    m_Index = ind
End Property

Public Function IConnector_Init(ByRef Parent1 As Object, ByRef Parent2 As Object) As Boolean
    Dim typ As Long
    IConnector_Init = False
    
    If Validate(Parent1, Parent2) Then
        Set m_Parent1 = Parent1
        Set m_Parent2 = Parent2
        'm_Type = typ
        IConnector_Init = True
    End If
End Function

Public Sub IConnector_Move(Optional ByVal ShiftX1 As Long = 0, Optional ByVal ShiftY1 As Long = 0, Optional ByVal ShiftX2 As Long = 0, Optional ByVal ShiftY2 As Long = 0)
    On Error GoTo Move_Error
    If Not Shape Is Nothing Then
        Shape.X1 = Shape.X1 + ShiftX1
        Shape.Y1 = Shape.Y1 + ShiftY1
        Shape.X2 = Shape.X2 + ShiftX2
        Shape.Y2 = Shape.Y2 + ShiftY2
    End If
Move_Exit:
    Exit Sub
Move_Error:
    MsgError "Move"
End Sub

Public Sub IConnector_Draw()
    Dim LeftUp1 As Point, RightDown1 As Point, LeftUp2 As Point, RightDown2 As Point
    On Error GoTo Draw_Error
    If Shape Is Nothing Then
        Set Shape = m_Editor.Shapes.Add(c_LineControl, c_NameConnector & m_Index)
        Shape.BorderWidth = c_WidthConnector
    End If
    m_Parent1.IShape_Position LeftUp1.X, LeftUp1.Y, RightDown1.X, RightDown1.Y
    m_Parent2.IShape_Position LeftUp2.X, LeftUp2.Y, RightDown2.X, RightDown2.Y
    IConnector_Move LeftUp1.X + (RightDown1.X - LeftUp1.X) / 2, LeftUp1.Y + (RightDown1.Y - LeftUp1.Y) / 2, _
        LeftUp2.X + (RightDown2.X - LeftUp2.X) / 2, LeftUp2.Y + (RightDown2.Y - LeftUp2.Y) / 2
    Shape.Visible = True
Draw_Exit:
    Exit Sub
Draw_Error:
    MsgError "Draw"
End Sub

Public Sub IConnector_SaveControl()
    Set Shape = Nothing
End Sub

Public Sub IConnector_Top()
    'On Error GoTo Top_Error
    If Not Shape Is Nothing Then
        Shape.ZOrder 0
    End If
'Top_Exit:
'    Exit Sub
'Top_Error:
'    MsgError "Top"
End Sub

Private Function Validate(ByRef Parent1 As Object, ByRef Parent2 As Object) As Boolean
    Dim prt1 As Object, prt2 As Object
    Validate = False
    Set prt1 = Parent1.Parent
    Set prt2 = Parent2.Parent
    If Not Parent1 Is Parent2 And Not prt1 Is prt2 Then
        If (prt1.Parent Is prt2.Parent) Or _
        (prt1 Is prt2.Parent) Or _
        (prt1.Parent Is prt2) _
        Then
            Validate = True
        End If
    End If
End Function


Private Sub MsgError(ByVal msg As String)
    m_Editor.MsgError c_NameConnector & ": " & msg & " (" & Err.Description & ")"
End Sub
